home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / Bonus / VCLZip / kpdemosd.exe / ZipUtil / Zip.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2001-07-11  |  49.1 KB  |  1,484 lines
  1. { ********************************************************************************** }
  2. {                                                                                    }
  3. {      COPYRIGHT 1997 Kevin Boylan                                                    }
  4. {     Source File: Unzip.pas                                                         }
  5. {     Description: VCLUnZip component demo - native Delphi unzip component.          }
  6. {     Date:        March 1997                                                        }
  7. {     Author:      Kevin Boylan, CIS: boylank                                        }
  8. {                                Internet: boylank@bigfoot.com                    }
  9. {                                                                                    }
  10. { ********************************************************************************** }
  11. unit zip;
  12. {$P-}
  13.  
  14. {  Sun 29 Mar 1998   10:49:13    Version: 2.1
  15. { Version 2.1 additions
  16. {
  17. { - Capability of 16bit VCLZip to store long filenames/paths
  18. { when running on 32 bit OS.
  19. { - New Store83Names property to force storing short
  20. { filenames and paths
  21. { - Better UNC path support.
  22. { - Fixed a bug to allow adding files to an empty archive.
  23. }
  24. {
  25. {  Tue 24 Mar 1998   19:03:57
  26. { Modifications to allow storing filenames and paths in DOS
  27. { 8.3 format
  28. }
  29. {
  30. {  Wed 11 Mar 1998   20:58:48  Version: 2.03
  31. { Version 2.03, Fixed several bugs.
  32. }
  33.  
  34. interface
  35.  
  36. uses
  37.    {$IFDEF WIN32}
  38.    Windows, ComCtrls,
  39.    {$ELSE}
  40.    WinTypes, WinProcs,
  41.    {$ENDIF}
  42.    SysUtils, Messages, ShellAPI, Classes, Graphics, Controls,
  43.    Forms, Dialogs, StdCtrls, ExtCtrls, Buttons,
  44.    Menus, Gauges, IncZip, Tabnotbk, IniFiles, OvrWrite, KPLib,
  45.    VCLZip, VCLUnZip, kpZipObj, kpSFXCfg;
  46.  
  47. type
  48.    TConfigInfo = record
  49.       DefaultViewer: string;
  50.       ForceDefaultViewer: Boolean;
  51.       LowerCaseFiles: Boolean;
  52.    end;
  53.  
  54.    TVCLZipForm = class(TForm)
  55.       Panel1: TPanel;
  56.       ExtractBtn: TSpeedButton;
  57.       OpenZipBtn: TSpeedButton;
  58.       StatusBar: TPanel;
  59.       Header1: THeader;
  60.       MainMenu1: TMainMenu;
  61.       FileMenu: TMenuItem;
  62.       Open1: TMenuItem;
  63.       Close1: TMenuItem;
  64.       N1: TMenuItem;
  65.       Exit1: TMenuItem;
  66.       Action1: TMenuItem;
  67.       Unzip1: TMenuItem;
  68.       Sort1: TMenuItem;
  69.       None1: TMenuItem;
  70.       FileName1: TMenuItem;
  71.       Dircetory1: TMenuItem;
  72.       Date1: TMenuItem;
  73.       Size1: TMenuItem;
  74.       Rate1: TMenuItem;
  75.       NoOrder: TMenuItem;
  76.       UncompressedSize1: TMenuItem;
  77.       Gauge1: TGauge;
  78.       CurrentFileLabel: TLabel;
  79.       Infowin: TMemo;
  80.       Gauge2: TGauge;
  81.       Label2: TLabel;
  82.       ZipCommentMnu: TMenuItem;
  83.       ExitBtn: TSpeedButton;
  84.       FilesList: TListBox;
  85.       ClearLogWindow1: TMenuItem;
  86.       FileSelectDlg: TOpenDialog;
  87.       Help1: TMenuItem;
  88.       About1: TMenuItem;
  89.       RenameDlg: TSaveDialog;
  90.       AddBtn: TSpeedButton;
  91.       NewZipBtn: TSpeedButton;
  92.       New1: TMenuItem;
  93.       Add1: TMenuItem;
  94.       Configure1: TMenuItem;
  95.       N2: TMenuItem;
  96.       ConfigBtn: TSpeedButton;
  97.       DeleteBtn: TSpeedButton;
  98.       AbortBtn: TSpeedButton;
  99.       BackupBtn: TSpeedButton;
  100.       ZipCommentBtn: TSpeedButton;
  101.       FileCommentBtn: TSpeedButton;
  102.       SaveMenuItem: TMenuItem;
  103.       FixMenu: TMenuItem;
  104.       Zipper: TVCLZip;
  105.       N3: TMenuItem;
  106.       MakeSFX32Mnu: TMenuItem;
  107.       Make16bitSFXMnu: TMenuItem;
  108.       ZipSizeLabel: TLabel;
  109.       Label1: TLabel;
  110.       DeleteFiles: TMenuItem;
  111.       ModifyPath: TMenuItem;
  112.       ModifyFilename1: TMenuItem;
  113.       N4: TMenuItem;
  114.       TestZipFile1: TMenuItem;
  115.       N5: TMenuItem;
  116.       SFXtoZipMnu: TMenuItem;
  117.     TestSelectedFiles1: TMenuItem;
  118.       procedure ExtractBtnClick(Sender: TObject);
  119.       procedure FormCreate(Sender: TObject);
  120.       procedure OpenZipBtnClick(Sender: TObject);
  121.       procedure OnExitBtn(Sender: TObject);
  122.       procedure Close1Click(Sender: TObject);
  123.       procedure OnSort(Sender: TObject);
  124.       procedure Header1Sized(Sender: TObject; ASection, AWidth: Integer);
  125.       procedure ZipperStartUnZip(Sender: TObject; FileIndex: Integer;
  126.          var FName: string; var Skip: Boolean);
  127.       procedure ZipperBadPassword(Sender: TObject; FileIndex: Integer; var NewPassword:
  128.          string);
  129.       procedure ZipperFilePercentDone(Sender: TObject; Percent: Longint);
  130.       procedure ZipperSkippingFile(Sender: TObject; Reason: TSkipReason; FName: string;
  131.          FileIndex: Integer; var Retry: Boolean );
  132.       procedure ZipperPromptForOverwrite(Sender: TObject; var OverWriteIt: Boolean;
  133.          FileIndex: Integer; var FName: string);
  134.       procedure ZipperBadCRC(Sender: TObject; CalcCRC, StoredCRC: LongInt; FileIndex: Integer);
  135.       procedure ZipperTotalPercentDone(Sender: TObject; Percent: LongInt);
  136.       procedure ZipCommentMnuClick(Sender: TObject);
  137.       procedure ZipperStartUnzipInfo(Sender: TObject; NumFiles: Integer;
  138.          TotalBytes: Comp; var StopNow: Boolean);
  139.       procedure ZipperGetNextDisk(Sender: TObject; NextDisk: Integer; var FName: string);
  140.       procedure FilesList1DrawItem(Control: TWinControl; Index: Integer;
  141.          Rect: TRect; State: TOwnerDrawState);
  142.       procedure FilesList1MeasureItem(Control: TWinControl; Index: Integer;
  143.          var Height: Integer);
  144.       procedure ZipperInCompleteZip(Sender: TObject;
  145.          var IncompleteMode: TIncompleteZipMode);
  146.       procedure ClearLogWindow1Click(Sender: TObject);
  147.       procedure FilesListDblClick(Sender: TObject);
  148.       procedure FormClose(Sender: TObject; var Action: TCloseAction);
  149.       procedure About1Click(Sender: TObject);
  150.       procedure NewZipBtnClick(Sender: TObject);
  151.       procedure OnAddFiles(Sender: TObject);
  152.       procedure FormKeyUp(Sender: TObject; var Key: Word;
  153.          Shift: TShiftState);
  154.       procedure Configure1Click(Sender: TObject);
  155.       procedure ZipperStartZip(Sender: TObject; FName: string;
  156.          var ZipHeader: TZipHeaderInfo; var Skip: Boolean);
  157.       procedure DeleteBtnClick(Sender: TObject);
  158.       procedure AbortBtnClick(Sender: TObject);
  159.       procedure BackupBtnClick(Sender: TObject);
  160.       procedure SaveMenuItemClick(Sender: TObject);
  161.       procedure FileCommentBtnClick(Sender: TObject);
  162.       procedure FileMenuClick(Sender: TObject);
  163.       procedure FixMenuClick(Sender: TObject);
  164.       procedure MakeSFX32MnuClick(Sender: TObject);
  165.       procedure Make16bitSFXMnuClick(Sender: TObject);
  166.       procedure ZipperEndZip(Sender: TObject; FName: string;
  167.          UncompressedSize, CompressedSize, CurrentZipSize: LongInt);
  168.       procedure ZipperStartZipInfo(Sender: TObject; NumFiles: Integer;
  169.          TotalBytes: Comp; var EndCentralRecord: TEndCentral; var StopNow: Boolean);
  170.       procedure ZipperDeleteEntry(Sender: TObject; FName: string;
  171.          var Skip: Boolean);
  172.       procedure ZipperDisposeFile(Sender: TObject; FName: string;
  173.          var Skip: Boolean);
  174.       procedure ModifyPathClick(Sender: TObject);
  175.       procedure ModifyFilename1Click(Sender: TObject);
  176.       procedure TestZipFile1Click(Sender: TObject);
  177.       procedure SFXtoZipMnuClick(Sender: TObject);
  178.       procedure ZipperUnZipComplete(sender: TObject; FileCount: Integer);
  179.     procedure ZipperUpdate(Sender: TObject; UDAction: TUpdateAction;
  180.       FileIndex: Integer);
  181.     procedure TestSelectedFiles1Click(Sender: TObject);
  182.     procedure ZipperRecursingFile(Sender: TObject; FName: String);
  183.    PRIVATE
  184.       { Private declarations }
  185.       procedure OpenTheZip;
  186.       procedure InitHeaderWidths;
  187.       procedure CleanupViewList;
  188.       procedure ReadIni;
  189.       procedure WriteIni;
  190.       procedure AddFiles;
  191.       procedure MakeFilesListFromListBox;
  192.       procedure DeleteFromZip;
  193.       procedure SetLogging;
  194.       procedure UpdateExtractDlg;
  195.       procedure GetExtractDlgInfo;
  196.       procedure UpdateCompressDlg;
  197.       procedure GetCompressDlgInfo;
  198.       procedure UpdateConfigDlg;
  199.       procedure GetConfigDlgInfo;
  200.       procedure MakeSFX(Stub: string);
  201.    PROTECTED
  202.       procedure Loaded; OVERRIDE;
  203.  
  204.    PUBLIC
  205.       { Public declarations }
  206.    end;
  207.  
  208. var
  209.    VCLZipForm                 : TVCLZipForm;
  210.    CheckedSortItem            : TMenuItem;
  211.    ViewFilesList              : TStringList;
  212.    ZipFromDir                 : string;
  213.    ConfigInfo                 : TConfigInfo;
  214.    sfx16, sfx32               : string;
  215.    Testing                    : Boolean;
  216.    checkZipper                : TVCLUnZip;
  217.    zipcounter                 : Integer;
  218.  
  219. implementation
  220.  
  221. uses Extract, Compress, Config, Comment, ModInfo, InvPwd;
  222.  
  223. {$R *.DFM}
  224.  
  225. procedure TVCLZipForm.FormCreate(Sender: TObject);
  226. var
  227.    CommandLine                : string;
  228.    ArgPos                     : Integer;
  229. begin
  230.    {  ReadIni;   }
  231.    InitHeaderWidths;
  232.    CheckedSortItem := NoOrder;
  233.    CheckedSortItem.Checked := True;
  234.    ViewFilesList := TStringList.Create;
  235.    { WIN32 includes module path\filename in cmdline }
  236.    CommandLine := PCharToStr(CmdLine);
  237.    {$IFDEF WIN32}
  238.    ArgPos := Pos(' ', CommandLine);
  239.    if (ArgPos = 0) or (ArgPos = Length(CommandLine)) then
  240.       CommandLine := ''
  241.    else
  242.       CommandLine := Copy(CommandLine, ArgPos + 1, Length(CommandLine));
  243.    {$ENDIF}
  244.    if (CommandLine = '') or (not (File_Exists(CommandLine))) then
  245.       Zipper.ZipName := '' { just to seed the initial directory for }
  246.    else { the open zip dialog box                }
  247.    begin
  248.       Zipper.ZipName := CommandLine;
  249.       OpenTheZip;
  250.    end;
  251.    Zipper.PreserveStubs := True;
  252.    Testing := False;
  253.    zipcounter := 0;
  254.    Zipper.FileOpenMode := fmShareDenyNone;
  255. end;
  256.  
  257. procedure TVCLZipForm.Loaded;
  258. begin
  259.    inherited Loaded;
  260.    ReadIni;
  261. end;
  262.  
  263. procedure TVCLZipForm.MakeFilesListFromListBox;
  264. var
  265.    i                          : Integer;
  266. begin
  267.    Zipper.FilesList.Clear;
  268.    for i := 0 to VCLZipForm.FilesList.Items.Count - 1 do
  269.       if VCLZipForm.FilesList.Selected[i] then
  270.          Zipper.Selected[i] := True;
  271.          {Zipper.FilesList.Add(Zipper.FullName[i]);}
  272. end;
  273.  
  274. procedure TVCLZipForm.UpdateExtractDlg;
  275. begin
  276.    Zipper.FilesList.Clear;                              {added 10/15/97 KLB}
  277.    with ExtractDlg do
  278.    begin
  279.       if FilesList.SelCount > 0 then
  280.          SelectedFiles.Checked := True
  281.       else
  282.          AllFilesRBtn.Checked := True;
  283.       DestDir.Text := Zipper.DestDir;
  284.       RelDir.Text := '';
  285.       Overwrite.ItemIndex := Ord(Zipper.OverwriteMode);
  286.       RecreateDir.Checked := Zipper.RecreateDirs;
  287.       RetainAttributesChk.Checked := Zipper.RetainAttributes;
  288.       Password.Text := Zipper.Password;
  289.    end;
  290. end;
  291.  
  292. procedure TVCLZipForm.GetExtractDlgInfo;
  293. begin
  294.    with ExtractDlg do
  295.    begin
  296.       Zipper.DoAll := AllFilesRBtn.Checked;
  297.       Zipper.DestDir := DestDir.Text;
  298.       Zipper.RootDir := RelDir.Text;
  299.       Zipper.OverwriteMode := TUZOverwriteMode(Overwrite.ItemIndex);
  300.       Zipper.RecreateDirs := RecreateDir.Checked;
  301.       Zipper.RetainAttributes := RetainAttributesChk.Checked;
  302.       Zipper.Password := Password.Text;
  303.    end;
  304. end;
  305.  
  306. procedure TVCLZipForm.ExtractBtnClick(Sender: TObject);
  307. var
  308.    NumUnZipped                : Integer;
  309. begin
  310.    NumUnZipped := 0;
  311.    try
  312.       if Zipper.Count = 0 then
  313.       begin
  314.          MessageBeep(0);
  315.          exit;
  316.       end;
  317.       with Zipper do
  318.       begin
  319.          UpdateExtractDlg;
  320.          if ExtractDlg.ShowModal <> mrOK then
  321.             exit;
  322.          GetExtractDlgInfo;
  323.          if DoAll then
  324.          begin
  325.             Screen.Cursor := crHourGlass;
  326.             NumUnZipped := UnZip;
  327.          end
  328.          else
  329.          begin
  330.             if ExtractDlg.UseMask.Checked then
  331.              begin
  332.                Zipper.FilesList.Add(ExtractDlg.ExtractMask.Text);
  333.                Screen.Cursor := crHourGlass;
  334.                NumUnZipped := UnZip;
  335.              end
  336.             else
  337.              begin
  338.                MakeFilesListFromListBox;
  339.                Screen.Cursor := crHourGlass;
  340.                NumUnZipped := UnZipSelected;
  341.              end;
  342.          end;
  343.       end;
  344.    finally
  345.       Gauge1.Progress := 0;
  346.       Gauge2.Progress := 0;
  347.       CurrentFileLabel.Caption := '';
  348.       Screen.Cursor := crDefault;
  349.       MessageBeep(0);
  350.       if NumUnZipped > 0 then
  351.          InfoWin.Lines.Add(IntToStr(NumUnZipped) + ' Files Unzipped!')
  352.       else
  353.          if Zipper.Count > 0 then
  354.             InfoWin.Lines.Add('No Files Unzipped!')
  355.    end;
  356. end;
  357.  
  358. procedure TVCLZipForm.OpenZipBtnClick(Sender: TObject);
  359. begin
  360.    try
  361.       Zipper.ZipName := ZipFromDir + '\?';
  362.    except
  363.       on EUserCanceled do
  364.       begin
  365.          Screen.Cursor := crDefault;
  366.          exit;
  367.       end
  368.    else
  369.       raise; { If not EUserCanceled then re-raise the exception }
  370.    end;
  371.    OpenTheZip;
  372. end;
  373.  
  374. procedure TVCLZipForm.OpenTheZip;
  375. var
  376.    TryAgain                   : Boolean;
  377.    tmpName                    : string;
  378. begin
  379.    with Zipper do
  380.       if (ZipName <> '') and (ZipName[Length(ZipName)] <> '?') then
  381.       begin
  382.          CleanupViewList;
  383.          tmpName := ZipName;
  384.          repeat
  385.             TryAgain := False;
  386.             try
  387.                ReadZip;
  388.             except
  389.                on EincompleteZip do
  390.                begin
  391.                  if
  392.                      MessageDlg('Enter Last Disk of Disk Set. Press Yes to continue or No to abort',
  393.                      mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  394.                    begin
  395.                      tryagain := True;
  396.                      ZipName := tmpName;
  397.                    end
  398.                   else
  399.                      tryagain := False;
  400.                end;
  401.             end;
  402.          until (TryAgain = False);
  403.  
  404.          if ZipName = '' then
  405.          begin
  406.             Close1Click(self);
  407.             exit;
  408.          end;
  409.  
  410.          { The following not needed since I fixed VCLUnZip 3/10/98 2.03}
  411.          if (NumDisks > 1) then                         { 3/7/98 2.03 }
  412.          begin
  413.             if ((AnsiCompareStr(ZipName[1], 'A') = 0) or (AnsiCompareStr(ZipName[1], 'A') = 0))
  414.                then
  415.                MultiMode := mmSpan
  416.             else
  417.                MultiMode := mmBlocks;
  418.          end;
  419.          Self.FilesList.Items.BeginUpdate;
  420.          FillList(Self.FilesList.Items);
  421.          Self.FilesList.Items.EndUpdate;
  422.          Self.FilesList.Update;
  423.          StatusBar.Caption := IntToStr(Zipper.Count) + ' Files';
  424.          ZipCommentMnu.Checked := Zipper.ZipHasComment;
  425.          Caption := ZipName;
  426.          ZipFromDir := ExtractFileDir(ZipName);
  427.          ZipSizeLabel.Caption := IntToStr(Zipper.ZipSize);
  428.       end;
  429. end;
  430.  
  431. procedure TVCLZipForm.InitHeaderWidths;
  432. begin
  433.    with Header1 do
  434.    begin
  435.       SectionWidth[0] := Canvas.TextWidth('XXXXXXXX.XXXX'); { File }
  436.       SectionWidth[1] := Canvas.TextWidth('XXXX/XX/XXX'); { Date }
  437.       SectionWidth[2] := Canvas.TextWidth('99:99PMX');  { Time }
  438.       SectionWidth[3] := Canvas.TextWidth('99999999');  { Size }
  439.       SectionWidth[4] := Canvas.TextWidth('99999999');  { Packed }
  440.       SectionWidth[5] := Canvas.TextWidth('XXXXx');     { Rate }
  441.       SectionWidth[6] := Canvas.TextWidth('XXXXXX');    { Method }
  442.       SectionWidth[7] := Canvas.TextWidth('XXXXXXXXXXXXXX'); { Path }
  443.    end;
  444. end;
  445.  
  446. procedure TVCLZipForm.OnExitBtn(Sender: TObject);
  447. begin
  448.    Close;
  449. end;
  450.  
  451. procedure TVCLZipForm.ReadIni;
  452. var
  453.    IniFile                    : TIniFile;
  454. begin
  455.    IniFile := TIniFile.Create('VCLZip.Ini');
  456.    with ConfigInfo, IniFile, Zipper do
  457.    begin
  458.       DefaultViewer := ReadString('Viewer', 'Default', 'NOTEPAD');
  459.       ForceDefaultViewer := ReadBool('Viewer', 'Force', False);
  460.       LowerCaseFiles := ReadBool('Viewer', 'Lowecase', True);
  461.       if not ReadBool('Logging', 'OnStartUnZipInfo', True) then
  462.          OnStartUnZipInfo := nil;
  463.       if not ReadBool('Logging', 'OnStartUnZip', True) then
  464.          OnStartUnZip := nil;
  465.       if not ReadBool('Logging', 'OnBadCRC', True) then
  466.          OnBadCRC := nil;
  467.       if not ReadBool('Logging', 'OnBadPassword', True) then
  468.          OnBadPassword := nil;
  469.       if not ReadBool('Logging', 'OnSkippingFile', True) then
  470.          OnSkippingFile := nil;
  471.       if not ReadBool('Logging', 'OnStartZipInfo', True) then
  472.          OnStartZipInfo := nil;
  473.       if not ReadBool('Logging', 'OnStartZip', True) then
  474.          OnStartZip := nil;
  475.       if not ReadBool('Logging', 'OnEndZip', True) then
  476.          OnEndZip := nil;
  477.       DestDir := ReadString('Paths', 'DestDir', 'c:\');
  478.       sfx16 := ReadString('SFX', '16Bit', '');
  479.       sfx32 := ReadString('SFX', '32Bit', '');
  480.       if sfx16 = '' then
  481.          sfx16 := ExtractFilePath(Application.EXEName) + 'zipsfx16.bin';
  482.       if sfx32 = '' then
  483.          sfx32 := ExtractFilePath(Application.EXEName) + 'zipsfx32.bin';
  484.       ZipFromDir := ReadString('Paths', 'FromDir', 'c:\');
  485.       if (Length(ZipFromDir) > 0) and (ZipFromDir[Length(ZipFromDir)] = '\') then
  486.          SetLength(ZipFromDir, Length(ZipFromDir) - 1);
  487.       IniFile.Free;
  488.    end;
  489. end;
  490.  
  491. procedure TVCLZipForm.WriteIni;
  492. var
  493.    IniFile                    : TIniFile;
  494. begin
  495.    IniFile := TIniFile.Create('VCLZip.Ini');
  496.    with IniFile, Zipper do
  497.    begin
  498.       WriteString('Viewer', 'Default', ConfigInfo.DefaultViewer);
  499.       WriteBool('Viewer', 'Force', ConfigInfo.ForceDefaultViewer);
  500.       WriteBool('Viewer', 'Lowercase', ConfigInfo.LowercaseFiles);
  501.       {$IFDEF WIN32}
  502.       WriteBool('Logging', 'OnStartUnZipInfo', Assigned(OnStartUnZipInfo));
  503.       WriteBool('Logging', 'OnStartUnZip', Assigned(OnStartUnZip));
  504.       WriteBool('Logging', 'OnBadCRC', Assigned(OnBadCRC));
  505.       WriteBool('Logging', 'OnBadPassword', Assigned(OnBadPassword));
  506.       WriteBool('Logging', 'OnSkippingFile', Assigned(OnSkippingFile));
  507.       WriteBool('Logging', 'OnStartZipInfo', Assigned(OnStartZipInfo));
  508.       WriteBool('Logging', 'OnStartZip', Assigned(OnStartZip));
  509.       WriteBool('Logging', 'OnEndZip', Assigned(OnEndZip));
  510.       {$ENDIF}
  511.       { Just to be sure, we don't want dialog boxes to come up if user has this app
  512.       associated with zip files and double clicks on a zip file in File Manager or
  513.       Explorer }
  514.       if Zipper.DestDir = '?' then
  515.          Zipper.DestDir := 'C:\';
  516.       if (ZipFromDir = '?') or (ZipFromDir = '') then
  517.          ZipFromDir := 'C:';
  518.       if ZipFromDir[Length(ZipFromDir)] = '\' then
  519.          SetLength(ZipFromDir, Length(ZipFromDir) - 1);
  520.       WriteString('Paths', 'DestDir', Zipper.DestDir);
  521.       WriteString('Paths', 'FromDir', ZipFromDir);
  522.       WriteString('SFX', '16Bit', sfx16);
  523.       WriteString('SFX', '32bit', sfx32);
  524.    end;
  525.    IniFile.Free;
  526. end;
  527.  
  528. procedure TVCLZipForm.CleanupViewList;
  529. var
  530.    i                          : Integer;
  531. begin
  532.    if ViewFilesList.Count > 0 then
  533.    begin
  534.       for i := 0 to ViewFilesList.Count - 1 do
  535.          SysUtils.DeleteFile(ViewFilesList[i]);
  536.       ViewFilesList.Clear;
  537.    end;
  538. end;
  539.  
  540. procedure TVCLZipForm.Close1Click(Sender: TObject);
  541. begin
  542.    FilesList.Clear;
  543.    Zipper.ClearZip;
  544.    CleanupViewList;
  545.    ZipSizeLabel.Caption := '0';
  546.    Caption := 'VCLUnZip Utility';
  547. end;
  548.  
  549. procedure TVCLZipForm.OnSort(Sender: TObject);
  550. begin
  551.    with Sender as TMenuItem do
  552.    begin
  553.       Zipper.Sort(TZipSortMode(Tag));
  554.       Zipper.FillList(FilesList.Items);
  555.       Checked := True;
  556.       CheckedSortItem.Checked := False;
  557.    end;
  558.    CheckedSortItem := TMenuItem(Sender);
  559. end;
  560.  
  561. procedure TVCLZipForm.Header1Sized(Sender: TObject; ASection,
  562.    AWidth: Integer);
  563. begin
  564.    FilesList.Refresh;
  565. end;
  566.  
  567. procedure TVCLZipForm.ZipperStartUnZip(Sender: TObject; FileIndex: Integer;
  568.    var FName: string; var Skip: Boolean);
  569. begin
  570.       If (Testing) then
  571.         Infowin.Lines.Add('Testing ' + TVCLUnZip(Sender).FullName[FileIndex])
  572.       Else
  573.         Infowin.Lines.Add('Unzipping ' + FName + '. Method -> ' +
  574.            TVCLUnZip(Sender).CompressMethodStr[FileIndex]);
  575.       StatusBar.Caption := 'UnZipping...';
  576.       CurrentFileLabel.Caption := TVCLUnZip(Sender).Filename[FileIndex];
  577.       CurrentFileLabel.Repaint;
  578. end;
  579.  
  580. procedure TVCLZipForm.ZipperBadPassword(Sender: TObject; FileIndex: Integer; var NewPassword:
  581.    string);
  582. var
  583.    MsgArray                   : array[0..255] of char;
  584. begin
  585.    with TVCLZip(Sender) do
  586.    begin
  587.       InvalidPwdDlg.PasswordEdit.Text := NewPassword;
  588.       InvalidPwdDlg.Filename.Caption := Filename[FileIndex];
  589.       MessageBeep(0);
  590.       InvalidPwdDlg.ShowModal;
  591.       if InvalidPwdDlg.ModalResult = mrOK then
  592.          NewPassword := InvalidPwdDlg.PasswordEdit.Text
  593.       else
  594.       begin
  595.          StrPCopy(MsgArray, 'Invalid Password for file ' + Filename[FileIndex]);
  596.          Application.MessageBox(MsgArray, 'Password Error', mb_OK);
  597.          InfoWin.Lines.Add('...Invalid password for file ' + Filename[FileIndex]);
  598.       end;
  599.    end;
  600. end;
  601.  
  602. procedure TVCLZipForm.ZipperFilePercentDone(Sender: TObject;
  603.    Percent: Longint);
  604. begin
  605.    Gauge1.Progress := Percent;
  606. end;
  607.  
  608. procedure TVCLZipForm.ZipperSkippingFile(Sender: TObject; Reason: TSkipReason; FName: string;
  609.    FileIndex: Integer; var Retry: Boolean );
  610. var
  611.    theReason                  : string;
  612. begin
  613.    if Reason = srFileOpenError then
  614.     begin
  615.       theReason := 'File ' + FName + ' is open.  Close the file and press OK to back it up ';
  616.       theReason := 'or press Cancel to skip it and continue backing up other files.';
  617.       if MessageDlg(theReason, mtWarning, [mbOK, mbCancel], 0) = mrOK then
  618.         Retry := True;
  619.       exit;
  620.     end;
  621.    if Reason = srBadPassword then
  622.       theReason := 'Bad Password'
  623.    else
  624.       if Reason = srNoOverwrite then
  625.       begin
  626.          if FileIndex = -1 then
  627.             theReason := 'Avoid duplicate entry'
  628.          else
  629.             theReason := 'Avoid Overwrite';
  630.       end
  631.       else
  632.          theReason := 'Error Opening File';
  633.  
  634.    with Zipper do
  635.       InfoWin.Lines.Add('...Skipping file ' + FName + '. Reason: ' + theReason);
  636. end;
  637.  
  638. procedure TVCLZipForm.ZipperPromptForOverwrite(Sender: TObject;
  639.    var OverWriteIt: Boolean; FileIndex: Integer; var FName: string);
  640. var
  641.    AllDone                    : Boolean;
  642. begin
  643.    AllDone := True;
  644.    with Zipper do
  645.       repeat
  646.          OverwriteDlg.FName.Caption := FName;
  647.          Screen.Cursor := crDefault;
  648.          OverwriteDlg.ShowModal;
  649.          Screen.Cursor := crHourGlass;
  650.          if OverwriteDlg.Action = oaOverwrite then
  651.             OverwriteIt := True
  652.          else
  653.             if OverwriteDlg.Action = oaSkip then
  654.                OverwriteIt := False;
  655.          if OverwriteDlg.Action = oaRename then
  656.             with RenameDlg do
  657.             begin
  658.                AllDone := False;
  659.                InitialDir := ExtractFilePath(FName);
  660.                FileName := ExtractFilename(FName);
  661.                if RenameDlg.Execute then
  662.                begin
  663.                   FName := FileName;
  664.                   OverWriteIt := True;
  665.                   AllDone := True;
  666.                end;
  667.             end;
  668.       until AllDone;
  669. end;
  670.  
  671. procedure TVCLZipForm.ZipperBadCRC(Sender: TObject;
  672.    CalcCRC, StoredCRC: LongInt; FileIndex: Integer);
  673. var
  674.    MsgArray                   : array[0..255] of char;
  675. begin
  676.    If Testing then
  677.       InfoWin.Lines.Add('...' + TVCLZip(Sender).Filename[FileIndex] + ' may be corrupt.')
  678.    else with Zipper do
  679.    begin
  680.       StrPCopy(MsgArray, 'Bad CRC for file ' + Filename[FileIndex]);
  681.       Application.MessageBox(MsgArray, 'CRC Error', mb_OK);
  682.       InfoWin.Lines.Add('...Bad CRC for file ' + Filename[FileIndex]);
  683.       InfoWin.Lines.Add('......Stored CRC is     ' + IntToStr(StoredCRC));
  684.       InfoWin.Lines.Add('......Calculated CRC is ' + IntToStr(CalcCRC));
  685.    end;
  686. end;
  687.  
  688. procedure TVCLZipForm.ZipperTotalPercentDone(Sender: TObject;
  689.    Percent: Longint);
  690. begin
  691.    Gauge2.Progress := Percent;
  692. end;
  693.  
  694. procedure TVCLZipForm.ZipCommentMnuClick(Sender: TObject);
  695. begin
  696.    if Zipper.ZipName <> '' then
  697.       with CommentEditor do
  698.       begin
  699.          CommentMemo.Clear;
  700.          CommentEditor.Caption := 'Editing Zip Comment for ' + ExtractFilename(Zipper.ZipName);
  701.          if Zipper.ZipHasComment then
  702.             CommentMemo.Text := Zipper.ZipComment;
  703.          ShowModal;
  704.          if ModalResult = mrOK then
  705.             if CommentMemo.Text <> Zipper.ZipComment then
  706.                Zipper.ZipComment := CommentMemo.Text;
  707.       end;
  708. end;
  709.  
  710. procedure TVCLZipForm.ZipperStartUnzipInfo(Sender: TObject;
  711.    NumFiles: Integer; TotalBytes: Comp; var StopNow: Boolean);
  712. begin
  713.    If Testing then
  714.      exit;
  715.    InfoWin.Lines.Add(' ');
  716.    InfoWin.Lines.Add('Number of files to be unzipped: ' + IntToStr(NumFiles));
  717.    InfoWin.Lines.Add('Total bytes to process: ' + FloatToStr(TotalBytes));
  718.    InfoWin.Lines.Add('Files unzipping to: ' + Zipper.DestDir);
  719. end;
  720.  
  721. procedure TVCLZipForm.SetLogging;
  722. begin
  723.    with Zipper, ConfigDlg do
  724.    begin
  725.       if OnStartUnZipInfoChk.Checked then
  726.          OnStartUnZipInfo := ZipperStartUnzipInfo
  727.       else
  728.          OnStartUnZipInfo := nil;
  729.       if OnStartUnZipChk.Checked then
  730.          OnStartUnZip := ZipperStartUnZip
  731.       else
  732.          OnStartUnZip := nil;
  733.       if OnBadCRCChk.Checked then
  734.          OnBadCRC := ZipperBadCRC
  735.       else
  736.          OnBadCRC := nil;
  737.       if OnBadPasswordChk.Checked then
  738.          OnBadPassword := ZipperBadPassword
  739.       else
  740.          OnBadPassword := nil;
  741.       if OnSkippingFileChk.Checked then
  742.          OnSkippingFile := ZipperSkippingFile
  743.       else
  744.          OnSkippingFile := nil;
  745.       if OnStartZipInfoChk.Checked then
  746.          OnStartZipInfo := ZipperStartZipInfo
  747.       else
  748.          OnStartZipInfo := nil;
  749.       if OnStartZipChk.Checked then
  750.          OnStartZip := ZipperStartZip
  751.       else
  752.          OnStartZip := nil;
  753.       if OnEndZipChk.Checked then
  754.          OnEndZip := ZipperEndZip
  755.       else
  756.          OnEndZip := nil;
  757.    end;
  758. end;
  759.  
  760. procedure TVCLZipForm.ZipperGetNextDisk(Sender: TObject;
  761.    NextDisk: Integer; var FName: string);
  762. var
  763.    {$IFDEF WIN32}
  764.    MsgArray                   : array[0..255] of Char;
  765.    {$ELSE}
  766.    MsgArray                   : string;
  767.    {$ENDIF}
  768. begin
  769.    if Zipper.MultiZipInfo.MultiMode = mmSpan then
  770.    begin
  771.       Screen.Cursor := crDefault;
  772.       {$IFDEF WIN32}
  773.       StrPCopy(MsgArray, 'Please insert disk ' + IntToStr(NextDisk) +
  774.          ' of the multi-disk set.');
  775.       {$ELSE}
  776.       MsgArray := 'Please insert disk ' + IntToStr(NextDisk) + ' of the multi-disk set.';
  777.       {$ENDIF}
  778.       if MessageDlg(MsgArray, mtConfirmation, [mbOK, mbCancel], 0) = mrCancel then
  779.          FName := '';
  780.       Screen.Cursor := crHourGlass;
  781.    end
  782.    else
  783.    begin
  784.       FName := ChangeFileExt(FName, '.' + Format('%3.3d', [NextDisk]));
  785.       {$IFDEF SKIPCODE}
  786.       FileSelectDlg.InitialDir := ExtractFilePath(FName);
  787.       FileSelectDlg.Title := 'Select Multi-Part Zip File Number ' + IntToStr(NextDisk);
  788.       FileSelectDlg.Filter := 'Zip Files (*.ZIP)|*.zip' + '|All Files (*.*)|*.*';
  789.       if FileSelectDlg.Execute then
  790.          FName := FileSelectDlg.Filename
  791.       else
  792.          FName := '';
  793.       {$ENDIF}
  794.    end;
  795. end;
  796.  
  797. procedure TVCLZipForm.FilesList1DrawItem(Control: TWinControl; Index: Integer;
  798.    Rect: TRect; State: TOwnerDrawState);
  799. var
  800.    r                          : TRect;
  801.    x                          : Integer;
  802.    FName                      : string;
  803.    ZipTimeStr                 : string;
  804.    ZipDateStr                 : string;
  805.    zSize, zPacked, zRate      : string;
  806. const
  807.    M                          = 4;                      { Margin }
  808. begin
  809.    if Index > Zipper.Count - 1 then
  810.       exit;
  811.    with (Control as TListBox) do
  812.       with Zipper do
  813.       begin
  814.          r := Rect;
  815.  
  816.          { Filename }
  817.          FName := Filename[Index];
  818.          if ConfigInfo.LowerCaseFiles then
  819.             FName := LowerCase(FName);
  820.          if IsEncrypted[Index] then
  821.             FName := FName + '#';
  822.          if FileHasComment[Index] then
  823.             FName := FName + '$';
  824.          r.Right := r.Left + Header1.SectionWidth[0];
  825.          x := r.Left + M;
  826.          Canvas.TextRect(r, x, r.Top, FName);
  827.  
  828.          { Date and Time }
  829.          ZipDateStr := Format('%8s', [FormatDateTime('yyyy/mm/dd', DateTime[Index])]);
  830.          ZipTimeStr := Format('%7s', [FormatDateTime('hh:mmam/pm', DateTime[Index])]);
  831.  
  832.          r.Left := r.Right;
  833.          r.Right := r.Left + Header1.SectionWidth[1];
  834.          x := r.Left + (r.Right - r.Left) - Canvas.TextWidth(ZipDateStr) - M;
  835.          Canvas.TextRect(r, x, r.Top, ZipDateStr);
  836.  
  837.          r.Left := r.Right;
  838.          r.Right := r.Left + Header1.SectionWidth[2];
  839.          x := r.Left + (r.Right - r.Left) - Canvas.TextWidth(ZipTimeStr) - M;
  840.          Canvas.TextRect(r, x, r.Top, ZipTimeStr);
  841.  
  842.          { Size }
  843.          r.Left := r.Right;
  844.          r.Right := r.Left + Header1.SectionWidth[3];
  845.          zSize := Format('%8d', [UnCompressedSize[Index]]);
  846.          x := r.Left + (r.Right - r.Left) - Canvas.TextWidth(zSize) - M;
  847.          Canvas.TextRect(r, x, r.Top, zSize);
  848.  
  849.          { Packed }
  850.          r.Left := r.Right;
  851.          r.Right := r.Left + Header1.SectionWidth[4];
  852.          zPacked := Format('%8d', [CompressedSize[Index]]);
  853.          x := r.Left + (r.Right - r.Left) - Canvas.TextWidth(zPacked) - M;
  854.          Canvas.TextRect(r, x, r.Top, zPacked);
  855.  
  856.          { Rate }
  857.          r.Left := r.Right;
  858.          r.Right := r.Left + Header1.SectionWidth[5];
  859.          zRate := Format('%3d%s', [100 - CRate(UnCompressedSize[Index], CompressedSize[Index]),
  860.             '%']);
  861.          x := r.Left + (r.Right - r.Left) - Canvas.TextWidth(zRate) - M;
  862.          Canvas.TextRect(r, x, r.Top, zRate);
  863.  
  864.          { Method }
  865.          r.Left := r.Right;
  866.          r.Right := r.Left + Header1.SectionWidth[6];
  867.          x := r.Left + M;
  868.          Canvas.TextRect(r, x, r.Top, CompressMethodStr[Index]);
  869.  
  870.          { Path }
  871.          r.Left := r.Right;
  872.          r.Right := r.Left + Header1.SectionWidth[7];
  873.          x := r.Left + M;
  874.          Canvas.TextRect(r, x, r.Top, Pathname[Index]);
  875.  
  876.          { Disk # }
  877.          r.Left := r.Right;
  878.          r.Right := r.Left + Header1.SectionWidth[8];
  879.          x := r.Left + M;
  880.          Canvas.TextRect(r, x, r.Top, IntToStr(DiskNo[Index]));
  881.  
  882.       end;
  883. end;
  884.  
  885. procedure TVCLZipForm.FilesList1MeasureItem(Control: TWinControl;
  886.    Index: Integer; var Height: Integer);
  887. begin
  888.    Height := (Control as TListBox).Canvas.TextHeight('W');
  889. end;
  890.  
  891. procedure TVCLZipForm.ZipperInCompleteZip(Sender: TObject;
  892.    var IncompleteMode: TIncompleteZipMode);
  893. var
  894.    IncZipDlg                  : TIncompleteZipDlg;
  895.    mResult                    : Integer;
  896. begin
  897.    IncZipDlg := TIncompleteZipDlg.Create(Self);
  898.    mResult := IncZipDlg.ShowModal;
  899.    if ( mResult = mrOK) then
  900.       IncompleteMode := izAssumeMulti
  901.    else if (mResult = mrRetry) then
  902.       IncompleteMode := izAssumeBad
  903.    else
  904.       IncompleteMode := izAssumeNotAZip;
  905.    IncZipDlg.Release;
  906. end;
  907.  
  908. procedure TVCLZipForm.ClearLogWindow1Click(Sender: TObject);
  909. begin
  910.    InfoWin.Clear;
  911. end;
  912.  
  913. procedure TVCLZipForm.FilesListDblClick(Sender: TObject);
  914. var
  915.    ViewFilePStr               : array[0..PATH_LEN] of char;
  916.    ViewFile                   : string;
  917.    tempPathPStr               : array[0..PATH_LEN] of char;
  918.    tempPath                   : string;
  919.    savePath                   : string;
  920.    saveRecreateDirs           : Boolean;
  921.    ExecStat                   : Integer;
  922.    Msg                        : array[0..255] of char;
  923. begin
  924.    GetTempPath(SizeOf(tempPathPStr), @tempPathPStr[0]);
  925.    tempPath := PCharToStr(tempPathPStr);
  926.    ViewFile := Zipper.Filename[FilesList.ItemIndex];
  927.    StrPCopy(PChar(@ViewFilePStr[0]), ViewFile);
  928.    Zipper.FilesList.Clear;
  929.    Zipper.FilesList.Add(Zipper.Fullname[FilesList.ItemIndex]);
  930.    saveRecreateDirs := Zipper.RecreateDirs;
  931.    Zipper.RecreateDirs := False;
  932.    savePath := Zipper.DestDir;
  933.    Zipper.DestDir := tempPath;
  934.    Zipper.Password := CompressDlg.Password.Text;
  935.    if ViewFilesList.IndexOf(tempPath + ViewFile) = -1 then
  936.       if (Zipper.UnZip > 0) then
  937.          ViewFilesList.Add(tempPath + ViewFile);
  938.    Zipper.DestDir := savePath;
  939.    Zipper.RecreateDirs := saveRecreateDirs;
  940.    if File_Exists(tempPath + ViewFile) then
  941.    begin
  942.       ExecStat := 32;
  943.       if not ConfigInfo.ForceDefaultViewer then
  944.          THandle(ExecStat) := ShellExecute(Handle, nil, ViewFilePStr, nil, tempPathPStr,
  945.             SW_SHOWNORMAL);
  946.       if (ExecStat < 32) or (ConfigInfo.ForceDefaultViewer) then
  947.       begin
  948.          StrPCopy(Msg, ConfigInfo.DefaultViewer + ' ' + tempPath + ViewFile);
  949.          ExecStat := WinExec(Msg, SW_SHOWNORMAL);
  950.       end;
  951.       if ExecStat < 32 then
  952.          ShowMessage('Couldn''t view file');
  953.       Gauge1.Progress := 0;
  954.       Gauge2.Progress := 0;
  955.       CurrentFileLabel.Caption := '';
  956.    end
  957.    else
  958.       ShowMessage('Couldn''t UnZip the file');
  959.    Screen.Cursor := crDefault;
  960. end;
  961.  
  962. procedure TVCLZipForm.FormClose(Sender: TObject; var Action: TCloseAction);
  963. var
  964.    MsgBoxResult               : WORD;
  965. begin
  966.    if Zipper.IsModified then
  967.    begin
  968.       MsgBoxResult :=
  969.          MessageDlg('This zip file has been modified.  Would you ' + #13 + #10 +
  970.          'like to save your changes?', mtConfirmation, [mbYes, mbNo, mbCancel], 0);
  971.       if MsgBoxResult = mrYes then
  972.       begin
  973.          Screen.Cursor := crHourGlass;
  974.          Zipper.SaveModifiedZipFile;
  975.          Screen.Cursor := crDefault;
  976.       end
  977.       else
  978.          if MsgBoxResult = mrCancel then
  979.             Action := caNone;
  980.    end;
  981.    if Action <> caNone then
  982.    begin
  983.       WriteIni;
  984.       CleanupViewList;
  985.       ViewFilesList.Free;
  986.    end;
  987. end;
  988.  
  989. procedure TVCLZipForm.About1Click(Sender: TObject);
  990. begin
  991.    ShowMessage('KpGb Zip Utility, Based on VCLZip Delphi Component' + #13 + #10 +
  992.       ' Copyright 1997 Kevin L. Boylan, KpGb Software');
  993. end;
  994.  
  995. procedure TVCLZipForm.NewZipBtnClick(Sender: TObject);
  996. begin
  997.    CompressDlg.SelectedFiles.Clear;
  998.    CompressDlg.ZipFilename.Enabled := True;
  999.    AddFiles;
  1000.    OpenTheZip;
  1001. end;
  1002.  
  1003. procedure TVCLZipForm.UpdateCompressDlg;
  1004. begin
  1005.    with CompressDlg do
  1006.    begin
  1007.       {$IFNDEF WIN32}
  1008.       SelectFilesBtn.Hint := 'Add files to list for zipping.  You may repeat this.';
  1009.       {$ENDIF}
  1010.       ZipFilename.Text := Zipper.ZipName;
  1011.       RootDir.Text := Zipper.RootDir;
  1012.       RelativeDir.Checked := Zipper.RelativePaths;
  1013.       RelativeDir.Enabled := (RootDir.Text <> '') and (Zipper.StorePaths);
  1014.       RecurseChk.Checked := Zipper.Recurse;
  1015.       SaveDirInfoChk.Checked := Zipper.StorePaths;
  1016.       SaveVolumesChk.Enabled := Zipper.StorePaths = True;
  1017.       SaveVolumesChk.Checked := (SaveVolumesChk.Enabled) and (Zipper.StoreVolumes);
  1018.       CompLevel.Caption := IntToStr(Zipper.PackLevel);
  1019.       Password.Text := Zipper.Password;
  1020.       MultiMode.ItemIndex := Ord(Zipper.MultiZipInfo.Multimode);
  1021.       SaveZipInfoChk.Checked := Zipper.MultiZipInfo.SaveZipInfoOnFirstDisk;
  1022.       ZipAction.ItemIndex := Ord(Zipper.ZipAction);
  1023.       WriteDiskLabelsChk.Checked := Zipper.MultiZipInfo.WriteDiskLabels;
  1024.       FirstBlockSize.Text := IntToStr(Zipper.MultiZipInfo.FirstBlockSize);
  1025.       BlockSize.Text := IntToStr(Zipper.MultiZipInfo.BlockSize);
  1026.    end;
  1027. end;
  1028.  
  1029. procedure TVCLZipForm.GetCompressDlgInfo;
  1030. begin
  1031.    with CompressDlg do
  1032.    begin
  1033.       Zipper.FilesList.Assign(CompressDlg.SelectedFiles.Items);
  1034.       Zipper.ZipName := ZipFilename.Text;
  1035.       Zipper.RootDir := RootDir.Text;
  1036.       Zipper.Recurse := RecurseChk.Checked;
  1037.       Zipper.StorePaths := SaveDirInfoChk.Checked;
  1038.       Zipper.StoreVolumes := SaveVolumesChk.Checked;
  1039.       Zipper.RelativePaths := RelativeDir.Checked;
  1040.       Zipper.PackLevel := StrToInt(CompLevel.Caption);
  1041.       Zipper.Dispose := DisposeChk.Checked;
  1042.       Zipper.Password := Password.Text;
  1043.       Zipper.MultiZipInfo.MultiMode := TMultiMode(MultiMode.ItemIndex);
  1044.       Zipper.ZipAction := TZipAction(ZipAction.ItemIndex);
  1045.       Zipper.MultiZipInfo.WriteDiskLabels := WriteDiskLabelsChk.Checked;
  1046.       If Zipper.MultiZipInfo.MultiMode = mmBlocks then
  1047.        begin
  1048.         Zipper.MultiZipInfo.FirstBlockSize := StrToInt(FirstBlockSize.Text);
  1049.         Zipper.MultiZipInfo.BlockSize := StrToInt(BlockSize.Text);
  1050.         Zipper.MultiZipInfo.SaveZipInfoOnFirstDisk := SaveZipInfoChk.Checked;
  1051.        end
  1052.       Else If Zipper.MultiZipInfo.MultiMode = mmSpan then
  1053.        begin
  1054.         Zipper.MultiZipInfo.SaveOnFirstDisk := StrToInt(FirstBlockSize.Text);
  1055.         Zipper.MultiZipInfo.SaveZipInfoOnFirstDisk := SaveZipInfoChk.Checked;
  1056.        end;
  1057.       Zipper.Store83Names := Store83Format.Checked;
  1058.    end;
  1059. end;
  1060.  
  1061. procedure TVCLZipForm.AddFiles;
  1062.  
  1063.    function IsANewZip: Boolean;
  1064.    begin
  1065.       Result := CompressDlg.ZipFilename.Enabled;
  1066.    end;
  1067.  
  1068. var
  1069.    NumZipped                  : Integer;
  1070. begin
  1071.    NumZipped := 0;
  1072.    Zipper.FilesList.Clear;
  1073.    UpdateCompressDlg;
  1074.    with CompressDlg do
  1075.    begin
  1076.       if IsANewZip then
  1077.       begin                                             { new zip file }
  1078.          GetZipFileDlg.Filename := '';
  1079.          if GetZipFileDlg.Execute then
  1080.          begin
  1081.             ZipFilename.Text := GetZipFileDlg.FileName;
  1082.             if UpperCase(ExtractFileExt(ZipFilename.Text)) <> '.ZIP' then
  1083.                ChangeFileExt(ZipFilename.Text, '.zip');
  1084.          end
  1085.          else
  1086.             exit;
  1087.       end;
  1088.    end;
  1089.    try
  1090.     try
  1091.       if (CompressDlg.ShowModal = mrOK) and (CompressDlg.SelectedFiles.Items.Count > 0) then
  1092.       begin
  1093.          GetCompressDlgInfo;
  1094.          Application.ProcessMessages;
  1095.          Screen.Cursor := crHourGlass;
  1096.          if (IsANewZip) and (FileExists(Zipper.ZipName)) then
  1097.             SysUtils.DeleteFile(Zipper.ZipName);
  1098.          NumZipped := Zipper.Zip;
  1099.          If (Zipper.MultiZipInfo.MultiMode = mmSpan) and (Zipper.MultiZipInfo.SaveZipInfoOnFirstDisk) then
  1100.            ShowMessage('Archive Configuration File has been saved');
  1101.          MessageBeep(0);
  1102.          OpenTheZip;
  1103.       end;
  1104.     except
  1105.      On EUserCanceled do
  1106.       begin
  1107.         StatusBar.Caption := '';
  1108.       end;
  1109.    end;
  1110.    finally
  1111.       Screen.Cursor := crDefault;
  1112.       Gauge1.Progress := 0;
  1113.       Gauge2.Progress := 0;
  1114.       zipcounter := 0;
  1115.       CurrentFileLabel.Caption := '';
  1116.       if NumZipped > 0 then
  1117.          InfoWin.Lines.Add(IntToStr(NumZipped) + ' Files Zipped!')
  1118.       else
  1119.          InfoWin.Lines.Add('No files were Zipped!');
  1120.    end;
  1121. end;
  1122.  
  1123. procedure TVCLZipForm.OnAddFiles(Sender: TObject);
  1124. begin
  1125.    if Zipper.ZipName <> '' then
  1126.    begin
  1127.       CompressDlg.SelectedFiles.Clear;
  1128.       CompressDlg.ZipFilename.Enabled := False;
  1129.       CompressDlg.ZipFileBtn.Enabled := False;
  1130.       AddFiles;
  1131.       CompressDlg.ZipFilename.Enabled := True;
  1132.       CompressDlg.ZipFileBtn.Enabled := True;
  1133.       OpenTheZip;
  1134.    end;
  1135. end;
  1136.  
  1137. procedure TVCLZipForm.DeleteFromZip;
  1138. var
  1139.   i:    Integer;
  1140. begin
  1141.    {MakeFilesListFromListBox;}
  1142.    Zipper.FilesList.Clear;
  1143.    for i := 0 to VCLZipForm.FilesList.Items.Count - 1 do
  1144.       if VCLZipForm.FilesList.Selected[i] then
  1145.          {Zipper.FilesList.Add(Zipper.FullName[i]);}
  1146.         Zipper.Selected[i] := True;
  1147.    Zipper.DeleteEntries;
  1148.    OpenTheZip;
  1149. end;
  1150.  
  1151. procedure TVCLZipForm.FormKeyUp(Sender: TObject; var Key: Word;
  1152.    Shift: TShiftState);
  1153. begin
  1154.    if (Key = 46) and (FilesList.SelCount > 0) then
  1155.       DeleteFromZip;
  1156. end;
  1157.  
  1158. procedure TVCLZipForm.UpdateConfigDlg;
  1159. begin
  1160.    with ConfigInfo, Zipper do
  1161.    begin
  1162.       ConfigDlg.DefaultViewer.Text := DefaultViewer;
  1163.       ConfigDlg.ForceDefaultViewer.Checked := ForceDefaultViewer;
  1164.       ConfigDlg.LowerCaseFiles.Checked := LowerCaseFiles;
  1165.       ConfigDlg.ProcessMessagesChk.Checked := DoProcessMessages;
  1166.       {$IFDEF WIN32}
  1167.       ConfigDlg.OnStartUnZipInfoChk.Checked := Assigned(OnStartUnZipInfo);
  1168.       ConfigDlg.OnStartUnZipChk.Checked := Assigned(OnStartUnZip);
  1169.       ConfigDlg.OnBadCRCChk.Checked := Assigned(OnBadCRC);
  1170.       ConfigDlg.OnBadPasswordChk.Checked := Assigned(OnBadPassword);
  1171.       ConfigDlg.OnSkippingFileChk.Checked := Assigned(OnSkippingFile);
  1172.       ConfigDlg.OnStartZipInfoChk.Checked := Assigned(OnStartUnZipInfo);
  1173.       ConfigDlg.OnStartZipChk.Checked := Assigned(OnStartZip);
  1174.       ConfigDlg.OnEndZipChk.Checked := Assigned(OnEndZip);
  1175.       {$ENDIF}
  1176.       ConfigDlg.sfx16.Text := sfx16;
  1177.       ConfigDlg.sfx32.Text := sfx32;
  1178.    end;
  1179. end;
  1180.  
  1181. procedure TVCLZipForm.GetConfigDlgInfo;
  1182. begin
  1183.    with ConfigInfo do
  1184.    begin
  1185.       DefaultViewer := ConfigDlg.DefaultViewer.Text;
  1186.       ForceDefaultViewer := ConfigDlg.ForceDefaultViewer.Checked;
  1187.       LowerCaseFiles := ConfigDlg.LowerCaseFiles.Checked;
  1188.       Zipper.DoProcessMessages := ConfigDlg.ProcessMessagesChk.Checked;
  1189.       sfx16 := ConfigDlg.sfx16.Text;
  1190.       sfx32 := ConfigDlg.sfx32.Text;
  1191.       SetLogging;
  1192.    end;
  1193. end;
  1194.  
  1195. procedure TVCLZipForm.Configure1Click(Sender: TObject);
  1196. begin
  1197.    UpdateConfigDlg;
  1198.    ConfigDlg.ShowModal;
  1199.    if ConfigDlg.ModalResult = mrOK then
  1200.       GetConfigDlgInfo;
  1201. end;
  1202.  
  1203. procedure TVCLZipForm.ZipperStartZip(Sender: TObject; FName: string;
  1204.    var ZipHeader: TZipHeaderInfo; var Skip: Boolean);
  1205. begin
  1206.    Inc(zipcounter);
  1207.    InfoWin.Lines.Add(IntToStr(zipcounter) + '. Zipping ' + FName);
  1208.    StatusBar.Caption := 'Zipping...';
  1209.    CurrentFileLabel.Caption := ExtractFilename(FName);
  1210.    CurrentFileLabel.Repaint;
  1211. end;
  1212.  
  1213.  
  1214.  
  1215. procedure TVCLZipForm.DeleteBtnClick(Sender: TObject);
  1216. begin
  1217.    if FilesList.SelCount > 0 then
  1218.       DeleteFromZip;
  1219. end;
  1220.  
  1221. procedure TVCLZipForm.AbortBtnClick(Sender: TObject);
  1222. begin
  1223.    MessageBeep(0);
  1224.    if (Testing) and (checkZipper <> nil) then
  1225.      checkZipper.CancelTheOperation
  1226.    else
  1227.      Zipper.CancelTheOperation;
  1228. end;
  1229.  
  1230. procedure TVCLZipForm.BackupBtnClick(Sender: TObject);
  1231. var
  1232.    tmpFilesList               : TStrings;
  1233.    i                          : Integer;
  1234. begin
  1235.    if Zipper.Count > 0 then
  1236.    begin
  1237.       tmpFilesList := TStringList.Create;
  1238.       try
  1239.          for i := 0 to Zipper.Count - 1 do
  1240.             if Pos(':', Zipper.Pathname[i]) > 0 then
  1241.                tmpFilesList.Add(Zipper.FullName[i]);
  1242.          if tmpFilesList.Count > 0 then
  1243.          begin
  1244.             if tmpFilesList.Count < Zipper.Count then
  1245.                if (MessageDlg('There are some entries that do not have'
  1246.                   + #13 + #10 + 'volume information.  These files will not be '
  1247.                   + #13 + #10 + 'backed up.', mtWarning, [mbOK, mbCancel], 0)
  1248.                   = mrCancel) then exit;
  1249.  
  1250.             Zipper.StorePaths := True;
  1251.             Zipper.StoreVolumes := True;
  1252.             Zipper.PackLevel := 9;
  1253.             CompressDlg.SelectedFiles.Items.Assign(tmpFilesList);
  1254.             CompressDlg.ZipFilename.Enabled := True;
  1255.             AddFiles;
  1256.          end
  1257.          else
  1258.             MessageDlg('None of this zips entries have volume information.'
  1259.                + #13 + #10 + 'Volume information is required for backups.', mtWarning, [mbOK],
  1260.                   0);
  1261.       finally
  1262.          tmpFilesList.Free;
  1263.       end;
  1264.    end;
  1265. end;
  1266.  
  1267. procedure TVCLZipForm.SaveMenuItemClick(Sender: TObject);
  1268. begin
  1269.    Screen.Cursor := crHourGlass;
  1270.    Zipper.SaveModifiedZipFile;
  1271.    OpenTheZip;
  1272.    Screen.Cursor := crDefault;
  1273. end;
  1274.  
  1275. procedure TVCLZipForm.FileCommentBtnClick(Sender: TObject);
  1276. var
  1277.    Idx                        : Integer;
  1278. begin
  1279.    if FilesList.SelCount > 1 then
  1280.       ShowMessage('You must select only one entry.')
  1281.    else
  1282.       if FilesList.SelCount = 0 then
  1283.          ShowMessage('Please select an entry first.')
  1284.       else
  1285.       begin
  1286.          with CommentEditor do
  1287.          begin
  1288.             Idx := FilesList.ItemIndex;
  1289.             CommentMemo.Clear;
  1290.             CommentEditor.Caption := 'Editing Zip Comment for ' + Zipper.Filename[Idx];
  1291.             if Zipper.FileHasComment[Idx] then
  1292.                CommentMemo.Text := Zipper.FileComment[Idx];
  1293.             ShowModal;
  1294.             if ModalResult = mrOK then
  1295.                if CommentMemo.Text <> Zipper.FileComment[Idx] then
  1296.                   Zipper.FileComment[Idx] := CommentMemo.Text;
  1297.          end;
  1298.       end;
  1299. end;
  1300.  
  1301. procedure TVCLZipForm.FileMenuClick(Sender: TObject);
  1302. begin
  1303.    SaveMenuItem.Enabled := Zipper.IsModified;
  1304.    SFXToZipMnu.Enabled := (Zipper.ZipName <> '') and
  1305.       (LowerCase(ExtractFileExt(Zipper.ZipName)) = '.exe');
  1306. end;
  1307.  
  1308. procedure TVCLZipForm.FixMenuClick(Sender: TObject);
  1309. begin
  1310.    Zipper.FixZip('', '');
  1311.    OpenTheZip;
  1312. end;
  1313.  
  1314. procedure TVCLZipForm.MakeSFX32MnuClick(Sender: TObject);
  1315. begin
  1316.    MakeSFX(sfx32);
  1317.    MessageBeep(0);
  1318.    OpenTheZip;
  1319. end;
  1320.  
  1321. procedure TVCLZipForm.MakeSFX(Stub: string);
  1322. begin
  1323.    if Zipper.ZipName = '' then
  1324.    begin
  1325.       ShowMessage('No zip to process');
  1326.       exit;
  1327.    end;
  1328.    Zipper.FilesList.Clear;
  1329.    Screen.Cursor := crHourGlass;
  1330.    try
  1331.        Zipper.MakeNewSFX(Stub,Zipper.ZipName,nil,0);
  1332.       {Zipper.MakeSFX(Stub, False);}
  1333.    finally
  1334.       Screen.Cursor := crDefault;
  1335.    end;
  1336. end;
  1337.  
  1338. procedure TVCLZipForm.Make16bitSFXMnuClick(Sender: TObject);
  1339. begin
  1340.    MakeSFX(sfx16);
  1341.    MessageBeep(0);
  1342.    OpenTheZip;
  1343. end;
  1344.  
  1345. procedure TVCLZipForm.ZipperEndZip(Sender: TObject; FName: string;
  1346.    UncompressedSize, CompressedSize, CurrentZipSize: LongInt);
  1347. begin
  1348.    InfoWin.Lines.Add(' ' + ExtractFilename(FName) + ' zipped. ' + IntToStr(UnCompressedSize) +
  1349.       ' ' + IntToStr(CompressedSize) + ' ' +
  1350.       IntToStr(100-crate(UncompressedSize, CompressedSize)) + '%');
  1351.    ZipSizeLabel.Caption := IntToStr(CurrentZipSize);
  1352. end;
  1353.  
  1354. procedure TVCLZipForm.ZipperStartZipInfo(Sender: TObject;
  1355.    NumFiles: Integer; TotalBytes: Comp; var EndCentralRecord: TEndCentral; var StopNow:
  1356.       Boolean);
  1357. begin
  1358.    InfoWin.Lines.Add(' ');
  1359.    InfoWin.Lines.Add('Number of files to be zipped: ' + IntToStr(NumFiles));
  1360.    InfoWin.Lines.Add('Total bytes to process: ' + FloatToStr(TotalBytes));
  1361. end;
  1362.  
  1363. procedure TVCLZipForm.ZipperDeleteEntry(Sender: TObject; FName: string;
  1364.    var Skip: Boolean);
  1365. begin
  1366.    if MessageDlg('Delete File ' + FName + '?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  1367.       InfoWin.Lines.Add('Deleting entry for ' + FName)
  1368.    else
  1369.       Skip := True;
  1370. end;
  1371.  
  1372. procedure TVCLZipForm.ZipperDisposeFile(Sender: TObject; FName: string;
  1373.    var Skip: Boolean);
  1374. begin
  1375.    InfoWin.Lines.Add('Removing: ' + FName);
  1376. end;
  1377.  
  1378. procedure TVCLZipForm.ModifyPathClick(Sender: TObject);
  1379. var
  1380.    i                          : Integer;
  1381. begin
  1382.    if FilesList.SelCount > 0 then
  1383.    begin
  1384.       ModInfoForm.NewInfoEdit.Text := '';
  1385.       ModInfoForm.ShowModal;
  1386.       if ModInfoForm.ModalResult = mrOK then
  1387.          for i := 0 to VCLZipForm.FilesList.Items.Count - 1 do
  1388.             if VCLZipForm.FilesList.Selected[i] then
  1389.                Zipper.Pathname[i] := ModInfoForm.NewInfoEdit.Text;
  1390.       SaveMenuItemClick(Self);
  1391.    end;
  1392. end;
  1393.  
  1394. procedure TVCLZipForm.ModifyFilename1Click(Sender: TObject);
  1395. begin
  1396.    if FilesList.SelCount = 1 then
  1397.    begin
  1398.       ModInfoForm.NewInfoEdit.Text := Zipper.Filename[FilesList.ItemIndex];
  1399.       ModInfoForm.ShowModal;
  1400.       if ModInfoForm.ModalResult = mrOK then
  1401.          Zipper.Filename[FilesList.ItemIndex] := ModInfoForm.NewInfoEdit.Text;
  1402.    end;
  1403. end;
  1404.  
  1405. procedure TVCLZipForm.TestZipFile1Click(Sender: TObject);
  1406. begin
  1407.    { A separate VCLZip object is used to test the integrity of the zip file so that we can
  1408.      have control over the events that get called }
  1409.    Testing := True;
  1410. {   checkZipper := TVCLUnZip.Create(Application);
  1411.    checkZipper.ZipName := Zipper.ZipName;
  1412.    checkZipper.Password := Zipper.Password;
  1413.    checkZipper.OnFilePercentDone := Zipper.OnFilePercentDone;
  1414.    checkZipper.OnTotalPercentDone := Zipper.OnTotalPercentDone;
  1415.    checkZipper.OnBadCRC := Zipper.OnBadCRC;
  1416.    checkZipper.OnBadPassword := Zipper.OnBadPassword;
  1417.    checkZipper.OnStartUnZip := Zipper.OnStartUnZip;
  1418.    checkZipper.ReadZip;
  1419. }
  1420.    InfoWin.Lines.Add('Beginning integrity test for ' + IntToStr(Zipper.Count) + ' files for ' +
  1421.       {check}Zipper.ZipName);
  1422.    if ({check}Zipper.CheckArchive) then
  1423.      InfoWin.Lines.Add('All Files OK')
  1424.    else
  1425.      InfoWin.Lines.Add('File(s) may be corrupted');
  1426.    {checkZipper.Free;}
  1427.    Gauge1.Progress := 0;
  1428.    Gauge2.Progress := 0;
  1429.    Testing := False;
  1430. end;
  1431.  
  1432. procedure TVCLZipForm.SFXtoZipMnuClick(Sender: TObject);
  1433. begin
  1434.    if (Zipper.ZipName <> '') and (Zipper.Count > 0) then
  1435.       Zipper.SFXToZip(True);
  1436.    SFXToZipMnu.Enabled := False;
  1437.    Caption := Zipper.ZipName;
  1438. end;
  1439.  
  1440. procedure TVCLZipForm.ZipperUnZipComplete(sender: TObject;
  1441.    FileCount: Integer);
  1442. begin
  1443.    {ShowMessage('Got Here');}
  1444. end;
  1445.  
  1446. procedure TVCLZipForm.ZipperUpdate(Sender: TObject;
  1447.   UDAction: TUpdateAction; FileIndex: Integer);
  1448. begin
  1449.   Case UDAction of
  1450.      uaReplacing: InfoWin.Lines.Add( 'Replacing ' + TVCLZip(Sender).FullName[FileIndex] );
  1451.      uaKeeping:   InfoWin.Lines.Add( 'Keeping ' + TVCLZip(Sender).FullName[FileIndex]   );
  1452.   end;
  1453. end;
  1454.  
  1455. procedure TVCLZipForm.TestSelectedFiles1Click(Sender: TObject);
  1456. var
  1457.    i                          : Integer;
  1458. begin
  1459.    Testing := True;
  1460.    if FilesList.SelCount > 0 then
  1461.    begin
  1462.      InfoWin.Lines.Add('>>> ' + IntToStr(FilesList.SelCount) + ' files to be tested.');
  1463.      for i := 0 to VCLZipForm.FilesList.Items.Count - 1 do
  1464.         if VCLZipForm.FilesList.Selected[i] then
  1465.            if Zipper.FileIsOK[i] then
  1466.               InfoWin.Lines.Add('>>> ' + Zipper.Filename[i] + ' tests OK.')
  1467.            else
  1468.               InfoWin.Lines.Add('>>> ' + Zipper.Filename[i] + ' may be corrupted.');
  1469.    end;
  1470.    Gauge1.Progress := 0;
  1471.    Gauge2.Progress := 0;
  1472.    Testing := False;
  1473. end;
  1474.  
  1475. procedure TVCLZipForm.ZipperRecursingFile(Sender: TObject; FName: String);
  1476. begin
  1477.    StatusBar.Caption := 'Recursing...';
  1478.    CurrentFileLabel.Caption := ExtractFilename(FName);
  1479.    CurrentFileLabel.Repaint;
  1480. end;
  1481.  
  1482. end.
  1483.  
  1484.